home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / tool+ / savedlg < prev    next >
Text File  |  1993-06-20  |  4KB  |  131 lines
  1. \ Dialog subclass that saves an ascii representation of its data. Data may
  2. \ be changed
  3. \ 11.26.90    rfl    added clear: parms to release:  An error may occur if the
  4. \                image is saved with parms. But fixed with new: sarray clearing size.
  5. \ 11.28.90    rfl    added dialog1 class to allow enabling etc. with controls
  6. \ 12.13.91    rfl    SP added alive: and close: to dialog1
  7. \ 3.3.92    rfl    changed string 161 to 186 for not finding STRG resource
  8. \ 5.13/93    rfl    no longer detach resource in grab; also, getnew: savedlg reads
  9. \                  in sarraystrg..don't have to grab at beginning of program
  10.  
  11.  
  12. :CLASS dialog1 <super dialog
  13.  
  14.   :M close: close: super clear: dialPtr ;M
  15.   :M alive: ( -- b) get: dialPtr 0 <> ;M
  16.   :M hiliteCtl: ( n item --) handle: self swap makeint call hiliteControl ;M
  17.   :M drawItem: ( item --) dup getText: self rot putText: self ;M
  18.   :M dim: { n item -- } item handle: self drop
  19.         get: itemType 4 and                            \ is it a control?
  20.         IF  n item hiliteCtl: self THEN                \ standard disable
  21.         get: itemType 16 and
  22.         IF -3 -3 inset: temprect THEN                \ is it editable text?
  23.         n 0<
  24.         IF 3 -> n                                    \ also grey out item rectangle
  25.             set: self w 11 call penMode n syspat +base call penpat
  26.              paint: temprect call penNormal
  27.         ELSE item drawItem: self                    \ redraw original item
  28.         THEN ;M
  29.  
  30.   :M enable: ( item --)   0 swap dim: self ;M
  31.   :M disable: ( item --) -1 swap dim: self ;M
  32.  
  33.   :M hideItem: ( item --) get: dialPtr swap makeint call hideDItem ;M
  34.   :M showItem: ( item --) get: dialPtr swap makeInt call showDItem ;M
  35.  
  36. ;CLASS
  37.  
  38. \ uses Pstring format (text with byte at front showing length of text)
  39. \  same as sarray, but can be read from resource.
  40. :CLASS sarrayStrg <super sarray
  41.  
  42.     int    resID
  43.     int    keepAsRsrc        \ true if want to save the info in rsrc file
  44.  
  45.   :M putResID: put: resID ;M
  46.  
  47.   :M SaveAsRsrc: true put: keepAsRsrc ;M
  48.   :M dontSaveAsRsrc: clear: keepAsRsrc ;M
  49.  
  50.   :M getnew: ( --)
  51.     get: resID 'type STG# (getres) m! m@ 0=
  52.     IF   new: self
  53.     ELSE get: self scount put: size
  54.     THEN ;M
  55.  
  56.   :M save: get: keepAsRsrc IF m@ call changedResource m@ call writeResource THEN ;M
  57.  
  58.   :M release: m@ call releaseResource 0 m! ;M
  59.  
  60. ;CLASS
  61.  
  62. :CLASS SaveDlg <super dialog1
  63.  
  64.     sarrayStrg    parms
  65.  
  66.   :M putResID: dup putResID: super putResID: parms ;M
  67.  
  68. \ doesn't save useritems, since methods are unknown...just adds place holder
  69.   :M save: clear: parms 0 0 add: parms limit 1
  70.         DO i handle: self drop get: itemType dup 4 and    \ 4=ctrlItem
  71.             IF   i get: self bin>asc add: parms drop
  72.             ELSE  $ 18 and                                \ $10 or $8=text item
  73.                  IF   i getText: self add: parms
  74.                  ELSE 0 0 add: parms                    \ any other item type, fake
  75.                  THEN
  76.             THEN
  77.         LOOP
  78.         save: parms ;M
  79.  
  80. \ doesn't handle a user item, since method of fill unknown
  81.    :M fill: limit: parms -dup
  82.         IF limit: self <> classErr" 186
  83.             limit 1
  84.             DO  i handle: self drop get: itemType dup 4 and
  85.                 IF   i at: parms asc>bin i put: self drop
  86.                 ELSE $ 18 and
  87.                     IF i  at: parms i putText: self THEN
  88.                 THEN
  89.             LOOP
  90.         THEN ;M
  91.  
  92.   :M getNew: getNew: super valid: parms not IF getNew: parms THEN fill: self ;M
  93.  
  94.   :M new: new: parms ;M
  95. \ grab a STG# resource and fill parms with it. Use in place of new.
  96. \ parms id is same as dialog
  97.   :M grab: ( --) get: resID putResID: parms getnew: parms ;M
  98.  
  99.   :M getParms: get: parms ;M
  100.   :M fillParms: ( anotherParm --) put: parms ;M
  101. \ fill an empty sarray (not new:) with IVARS of pars
  102.   :M =: { mySarray -- } addr: parms mySarray length: mySarray cmove ;M
  103.   :M atParm: ( ind -- addr len) at: parms ;M
  104.   :M toParm: ( addr len ind --) to: parms ;M
  105.   :M print: print: parms ;M
  106.  
  107.   :M closeSave: save: self close: self ;M
  108.  
  109.   :M release: release: parms clear: parms ;M
  110.  
  111.   :M lock: lock: parms ;M
  112.   :M unlock: unlock: parms ;M
  113.  
  114.   :M saveAsRsrc: saveAsRsrc: parms ;M
  115.   :M dontSaveAsRsrc: dontSaveAsRsrc: parms ;M
  116.  
  117. \ for saving and restoring parameters to disk
  118.   :M write: size: parms sp@ 4 write: topfile 2drop
  119.         lock: parms get: parms write: topfile drop unlock: parms ;M
  120.  
  121.   :M read: buf255 4 read: topfile drop
  122.         buf255 @ setsize: parmstr topfile size: parmstr read: parmstr drop
  123.         lock: parmstr get: parmstr put: parms unlock: parmstr ;M
  124.  
  125. ;CLASS
  126.  
  127. : getter save: caller closer ;
  128.  
  129. \ ascii string true...use with atParm: which returns a " 1" or " 0"
  130. : s1= " 1" s= ;
  131.